// RealPlay Ltd  copyrights.
// This program is Open Source AsIs
// You may use it for all purposes, including commercial
// But!!!
// If you use any part of this code, you must state clearly
// both in your source file and in the Help|about of your program,
// that the origin program or code was built by RealPlay Ltd

// ***********************************************************************/
// *                                                                     */
// *        This file is only the menu of "Paint" Program                */
// *                                                                     */
// ***********************************************************************/

unit UPMenu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ActnList, ActnMan, StdActns, ExtDlgs, Translation;

type
  TFMenu = class(TForm)
    Menu1: TMainMenu; // The MainMenu
    ActionListFile1: TActionList;
    //
    // sub Menu & Actions
    //
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    N2: TMenuItem;
    ARealPlay: TAction;
    FileExit1: TFileExit;
    RealPlay1: TMenuItem;
    ANew: TAction;
    AOpen: TAction;
    ASave: TAction;
    ASaveAs: TAction;
    Edit1: TMenuItem;
    Undo1: TMenuItem;
    Redo1: TMenuItem;
    N3: TMenuItem;
    AUndo: TAction;
    ARedo: TAction;
    ACopy: TAction;
    APaste: TAction;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    AZoomx1: TAction;
    View1: TMenuItem;
    Zoomx11: TMenuItem;
    AZoom: TAction;
    Zoom1: TMenuItem;
    Image1: TMenuItem;
    Colors1: TMenuItem;
    Color1: TMenuItem;
    SetColor1: TMenuItem;
    ASetColor: TAction;
    ASetFillDepth: TAction;
    ASetFillDepth1: TMenuItem;
    MenuRAni: TMenuItem;
    AShowAnimation: TAction;
    ShowAnimationpreview1: TMenuItem;
    AShowXML: TAction;
    ShowRealXML1: TMenuItem;
    MenuRMount: TMenuItem;
    Help1: TMenuItem;
    CuttoNewLayer1: TMenuItem;
    ACarrierMount: TAction;
    CarrierMount1: TMenuItem;
    Acount1: TMenuItem;
    Bill1: TMenuItem;
    ACut: TAction;
    Cut1: TMenuItem;
    APrint: TAction;
    Print1: TMenuItem;
    N4: TMenuItem;
    About1: TMenuItem;
    QuickOverview1: TMenuItem;
    HelponWeb1: TMenuItem;
    AnimationHelpfromRealPlayWeb1: TMenuItem;
    SD: TSavePictureDialog;
    OPD1: TOpenPictureDialog;
    PrintDialog1: TPrintDialog;
    ClearSelect1: TMenuItem;
    SelectAll1: TMenuItem;
    N5: TMenuItem;
    Copyto1: TMenuItem;
    ACopyTo: TAction;
    APasteFrom: TAction;
    Pastefrom1: TMenuItem;
    AToolBox: TAction;
    N6: TMenuItem;
    ToolBox1: TMenuItem;
    AColorBox: TAction;
    CarrierMount2: TMenuItem;
    AStatusBar: TAction;
    StatusBar1: TMenuItem;
    AFlip: TAction;
    AShowHTML: TAction;
    ShowRealHTMLinExplorer1: TMenuItem;
    Language1: TMenuItem;
    English1: TMenuItem;
    Hebrew1: TMenuItem;
    AEnglish: TAction;
    AHebrew: TAction;
    AStretch: TAction;
    AInvert: TAction;
    AAtributes: TAction;
    AClearImage: TAction;
    ADrawOpaque: TAction;
    StretchSkew1: TMenuItem;
    InvertColors1: TMenuItem;
    ClearImage1: TMenuItem;
    DrawOpaque1: TMenuItem;
    Atributes1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ANewExecute(Sender: TObject);
    procedure AOpenExecute(Sender: TObject);
    procedure ASaveExecute(Sender: TObject);
    procedure ASaveAsExecute(Sender: TObject);
    procedure ARealPlayExecute(Sender: TObject);
    procedure MenuFileClick(Sender: TObject);
    procedure AUndoExecute(Sender: TObject);
    procedure ARedoExecute(Sender: TObject);
    procedure ACopyExecute(Sender: TObject);
    procedure APasteExecute(Sender: TObject);
    procedure AZoomx1Execute(Sender: TObject);
    procedure AZoomExecute(Sender: TObject);
    procedure ASetColorExecute(Sender: TObject);
    procedure ASetFillDepthExecute(Sender: TObject);
    procedure AShowAnimationExecute(Sender: TObject);
    procedure AShowXMLExecute(Sender: TObject);
    procedure ACarrierMountExecute(Sender: TObject);
    procedure ACutExecute(Sender: TObject);
    procedure APrintExecute(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure QuickOverview1Click(Sender: TObject);
    procedure HelponWeb1Click(Sender: TObject);
    procedure AnimationHelpfromRealPlayWeb1Click(Sender: TObject);
    procedure SDTypeChange(Sender: TObject);
    procedure ClearSelect1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure ACopyToExecute(Sender: TObject);
    procedure APasteFromExecute(Sender: TObject);
    procedure AToolBoxExecute(Sender: TObject);
    procedure AColorBoxExecute(Sender: TObject);
    procedure AStatusBarExecute(Sender: TObject);
    procedure AFlipExecute(Sender: TObject);
    procedure AShowHTMLExecute(Sender: TObject);
    procedure AEnglishExecute(Sender: TObject);
    procedure AHebrewExecute(Sender: TObject);
    procedure AStretchExecute(Sender: TObject);
    procedure AInvertExecute(Sender: TObject);
    procedure AAtributesExecute(Sender: TObject);
    procedure AClearImageExecute(Sender: TObject);
    procedure ADrawOpaqueExecute(Sender: TObject);
  private
    procedure TranslateMenuItems(LanguageCode: Char; ItemList: TStringList; AMenuItem: TMenuItem);
    procedure UpdateCaption(LanguageCode: Char);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMenu: TFMenu;

implementation

uses printers,
  UPUtil,
  UPActions, UPMain, UPScaleDlg, UPFloodfill, UP_XML, UPCarrierMount,
  reabout, HelpOverViewpas, UPflip, UPAtr, UPStretchSkew;
{$R *.dfm}

procedure TFMenu.FormCreate(Sender: TObject);
Var
  mi: TMenuItem;
  i: integer;
  FileNames: TStringList;
begin
  menu := nil;
  MenuRAni.Visible := false;
  MenuRMount.Visible := false;
  FPaint.menu := Menu1;
{$IF defined(DEBUG)}
  ARealPlayExecute(self);
{$IFEND}
  FileNames := readfilenames;
  if FileNames.Count > 0 then
  begin
    mi := TMenuItem.Create(self);
    mi.Caption := '-';
    File1.Add(mi);
    for i := 0 to FileNames.Count - 1 do
    begin
      mi := TMenuItem.Create(self);
      mi.Caption := '&' + inttostr(i + 1) + ' ' + FileNames[i];
      File1.Add(mi);
      mi.OnClick := MenuFileClick;
    end;
  end;
  FileNames.free;
  if ParamCount >= 1 then
    openFile(ParamStr(1))
  else
    ANewExecute(nil);
end;

procedure TFMenu.ANewExecute(Sender: TObject);
begin
  UPActions.ActionFileNew;
end;

procedure TFMenu.AOpenExecute(Sender: TObject);
begin
  UPActions.ActionFileOpen;
end;

procedure TFMenu.ASaveExecute(Sender: TObject);
begin
  UPActions.ActionFileSave;
end;

procedure TFMenu.ASaveAsExecute(Sender: TObject);
begin
  UPActions.ActionFileSaveAs;
end;

procedure TFMenu.ARealPlayExecute(Sender: TObject);
begin
  MenuRAni.Visible := true;
  MenuRMount.Visible := true;
  FPaint.FrRTool1.Show;
end;

procedure TFMenu.MenuFileClick(Sender: TObject);
var
  fname: string;
begin
  fname := copy(TMenuItem(Sender).Caption, 4, 1000);
  if ExtractFilePath(fname) = '' then
    fname := ExtractFilePath(FMenu.OPD1.FileName) + fname;
  openFile(fname);
end;

procedure TFMenu.AUndoExecute(Sender: TObject);
begin
  FPaint.FWA.ZF.GetF;
end;

procedure TFMenu.ARedoExecute(Sender: TObject);
begin
  FPaint.FWA.ZF.GetB;
end;

procedure TFMenu.ACopyExecute(Sender: TObject);
begin
  UPActions.ActionEditCopy;
end;

procedure TFMenu.ACutExecute(Sender: TObject);
begin
  UPActions.ActionEditCopy;
  FPaint.FWA.ImSelS.clearSel;
end;

procedure TFMenu.APasteExecute(Sender: TObject);
begin
  UPActions.ActionEditPaste;
end;

procedure TFMenu.AZoomx1Execute(Sender: TObject);
begin
  UPActions.ActionViewZoomX1;
end;

procedure TFMenu.AZoomExecute(Sender: TObject);
begin
  FScaleDlg.ShowModal;
end;

procedure TFMenu.ASetColorExecute(Sender: TObject);
begin
  FPaint.FrColor1.PcClick(nil);
end;

procedure TFMenu.ASetFillDepthExecute(Sender: TObject);
begin
  FBinDepthDlg.ShowModal;
end;

procedure TFMenu.AShowAnimationExecute(Sender: TObject);
begin
  UPActions.ActionRealAShow;
end;

procedure TFMenu.AShowXMLExecute(Sender: TObject);
begin
  Fxml.ShowModal;
end;

procedure TFMenu.ACarrierMountExecute(Sender: TObject);
begin
  FCarrierMount.ShowModal;
end;

procedure TFMenu.APrintExecute(Sender: TObject);
var
  scaleX, scaleY: real;
  iY, iX: integer;
  RR: TRect;
begin
  with FPaint do
  begin
    PrintDialog1.Options := [poPageNums, poSelection];
    PrintDialog1.FromPage := 1;
    PrintDialog1.MinPage := 1;
    PrintDialog1.ToPage := 1;
    PrintDialog1.MaxPage := 1;
    if PrintDialog1.Execute then
      with PrintDialog1 do
        with Printer do
          try
            iX := PixelsPerInch;
            if iX = 0 then
            begin
              MessageDlg('print pixel per inch error', mtError,
                [mbOk, mbCancel], 0);
              exit;
            end;
            scaleX := GetDeviceCaps(Handle, logPixelsy) / iX;
            scaleY := GetDeviceCaps(Handle, logPixelsy) / iX;
            iX := round(FWA.Im.width * scaleX);
            iY := round(FWA.Im.Height * scaleY);
            // the section below ensures big picture will go in to one page of the printer
            if iX + 100 > PageWidth then
            begin
              scaleX := PageWidth / iX;
              iX := trunc(iX * scaleX);
              iY := trunc(iX * scaleX);
            end;
            if iY + 100 > PageHeight then
            begin
              scaleX := PageHeight / iY;
              iX := trunc(iX * scaleX);
              iY := trunc(iX * scaleX);
            end;
            BeginDoc;
            RR := Rect(0, 0, iX, iY);
            Canvas.StretchDraw(RR, FWA.Im.Picture.Graphic);
          finally
            EndDoc;
            FPaint.FWA.ZF.GetN;
          end;
  end;
end;

procedure TFMenu.About1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TFMenu.QuickOverview1Click(Sender: TObject);
begin
  FHelpOV.Show;
end;

procedure TFMenu.HelponWeb1Click(Sender: TObject);
var
  stexe: AnsiString;
begin
  stexe := BrowserPath +
    ' "http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/mspaint_overview.mspx?mfr=true"';
  winexec(PAnsiChar(stexe), SW_SHOW);
end;

procedure TFMenu.AnimationHelpfromRealPlayWeb1Click(Sender: TObject);
var
  stexe: AnsiString;
begin
  stexe := BrowserPath + ' "http://www.therealplay.com/page010.aspx"';
  winexec(PAnsiChar(stexe), SW_SHOW);
end;

procedure TFMenu.SDTypeChange(Sender: TObject);
begin
  if SD.FilterIndex = 2 then
    if (MessageDlg('Saving the file in Monochrome will'#13 +
          'Permenently erase color information!'#13 +
          ' Are you sure you want this?', mtWarning, [mbYes, mbNo], 0) = mrYes)
      and (MessageDlg('I am asking again, Are you sure?', mtWarning,
        [mbYes, mbNo], 0) = mrYes) then
      FPaint.FWA.Im.Picture.Bitmap.Monochrome := true
    else
      SD.FilterIndex := 1;
end;

procedure TFMenu.ClearSelect1Click(Sender: TObject);
begin
  FPaint.FWA.ImSelS.clearSel;
end;

procedure TFMenu.SelectAll1Click(Sender: TObject);
begin
  FPaint.FWA.ImSelS.SelectAll;
end;

procedure TFMenu.ACopyToExecute(Sender: TObject);
var
  tmpname: string;
begin
  tmpname := SD.FileName;
  SD.FileName := '';
  if SD.Execute then
    if fileexists(SD.FileName) and (MessageDlg(SD.FileName +
          ' file exists!'#13'Do you want to replace it?', mtWarning,
        [mbYes, mbNo], 0) = mrYes) then
      ActionSave(FPaint.FWA.Im.Picture.Bitmap, SD.FileName);
  SD.FileName := tmpname;
end;

procedure TFMenu.APasteFromExecute(Sender: TObject);
var
  tmpname: string;
begin
  tmpname := OPD1.FileName;
  OPD1.FileName := '';
  if OPD1.Execute then
  begin
    FPaint.FWA.ImSelS.clearSel;
    openFile(OPD1.FileName);
    FPaint.FWA.ImSelS.SelectAll;
    FPaint.FWA.ZF.GetN;
  end;
  OPD1.FileName := tmpname;
end;

procedure TFMenu.AToolBoxExecute(Sender: TObject);
begin
  AToolBox.Checked := not AToolBox.Checked;
  if AToolBox.Checked then
    FPaint.PanelLeft.Show
  else
    FPaint.PanelLeft.Hide;
end;

procedure TFMenu.AColorBoxExecute(Sender: TObject);
begin
  AColorBox.Checked := not AColorBox.Checked;
  if AColorBox.Checked then
    FPaint.PanelBottom.Show
  else
    FPaint.PanelBottom.Hide;

end;

procedure TFMenu.AStatusBarExecute(Sender: TObject);
begin
  AStatusBar.Checked := not AStatusBar.Checked;
  if AStatusBar.Checked then
    FPaint.SBar.Show
  else
    FPaint.SBar.Hide;

end;

procedure TFMenu.AFlipExecute(Sender: TObject);
begin
  Fflip.ShowModal;
end;

procedure TFMenu.AShowHTMLExecute(Sender: TObject);
var
  proc_info: TProcessInformation;
  startinfo: TStartupInfo;
  ExitCode: longword;
  stexe: AnsiString;
begin
  /// / Initialize the structures
  FillChar(proc_info, sizeof(TProcessInformation), 0);
  FillChar(startinfo, sizeof(TStartupInfo), 0);
  startinfo.cb := sizeof(TStartupInfo);
  // Attempts to create the process
  stexe := ExtractFilePath(application.ExeName);
  stexe := BrowserPath + ' "' + stexe + 'Real\Default.html"';
  // winexec(pchar(stexe),SW_SHOW);
  if CreateProcess(nil, pchar(stexe), nil, nil, false, NORMAL_PRIORITY_CLASS,
    nil, nil, startinfo, proc_info) <> false then
  begin
    // The process has been successfully created
    // Now let's wait till it ends...
    FPaint.Hide;
    WaitForSingleObject(proc_info.hProcess, INFINITE);
    // Process has finished. Now we should close it.
    GetExitCodeProcess(proc_info.hProcess, ExitCode); // Optional
    CloseHandle(proc_info.hThread);
    CloseHandle(proc_info.hProcess);
    FPaint.Show;
  end;
end;

function LoadTranslate(language: Char; formName: String): TStringList;
var
  TranslationList: IXMLTranslationType;
  ItemList: IXMLItemType;
  i, J: integer;
  exitFlag: Boolean;
  resultList: TStringList;
begin
  exitFlag := not FileExists('Translation.XML') ;
  if (TranslationList = nil) and (not exitFlag) then
    TranslationList := Loadtranslation('Translation.XML');
  resultList := TStringList.Create;
  resultList.Clear;
  i := 0;
  while (not exitFlag) and (i < TranslationList.Count) do
  begin
    if (formName = TranslationList.Form[i].Name) then
    begin
      J := 0;
      while (J < TranslationList.Form[i].Count) do
      begin
        ItemList := TranslationList.Form[i].Item[J];
        if (ItemList.Name <> '') then
          case language of
            'H':
              if (ItemList.Hebrew <> '') then
              begin
                resultList.Add(ItemList.Name);
                resultList.Add(ItemList.Hebrew);
              end;
            'E':
              if (ItemList.English <> '') then
              begin
                resultList.Add(ItemList.Name);
                resultList.Add(ItemList.English);
              end;
          end;
        INC(J);
      end;
    end;
    INC(i);
  end;
  result := resultList;
end;

function Translate(language: Char; formName: String;
  controlName: String): String;
var
  TranslationList: IXMLTranslationType;
  ItemList: IXMLItemType;
  i, J: integer;
  exitFlag: Boolean;
begin
  exitFlag := not FileExists('Translation.XML') ;
  if (TranslationList = nil) and (not exitFlag) then
    TranslationList := Loadtranslation('Translation.XML');

  i := 0;
  while (not exitFlag) and (i < TranslationList.Count) do
  begin
    if (formName = TranslationList.Form[i].Name) then
    begin
      J := 0;
      while (not exitFlag) and (J < TranslationList.Form[i].Count) do
      begin
        ItemList := TranslationList.Form[i].Item[J];
        if (controlName = ItemList.Name) then
          case language of
            'H':
              begin
                result := ItemList.Hebrew;
                exitFlag := true;
              end;
            'E':
              begin
                result := ItemList.English;
                exitFlag := true;
              end;
          end;
        INC(J);
      end;
    end;
    INC(i);
  end;
end;

procedure TFMenu.TranslateMenuItems(LanguageCode: Char; ItemList: TStringList; AMenuItem: TMenuItem);
var
  i, index: integer;
begin
  for i := 0 to AMenuItem.Count - 1 do
  begin
    index := ItemList.IndexOf(AMenuItem[i].Name);
    if (index >= 0) then
      if (ItemList[index + 1] <> '') then
        AMenuItem[i].Caption := ItemList[index + 1];
    TranslateMenuItems(LanguageCode, ItemList, AMenuItem[i]) ;
  end ;
end;

procedure TFMenu.UpdateCaption(LanguageCode: Char);
var
  ItemList: TStringList;
begin
  FPaint.Caption := Translate(LanguageCode, FPaint.Name, FPaint.Name);
  ItemList := LoadTranslate(LanguageCode, FPaint.Name);
  TranslateMenuItems(LanguageCode, ItemList, Menu1.Items) ;
  ItemList.free;
end;

procedure TFMenu.AEnglishExecute(Sender: TObject);
begin
  if (FPaint.BiDiMode = bdRightToLeft) then
    FPaint.FlipChildren(true);
  FPaint.BiDiMode := bdLeftToRight;
  FMenu.BiDiMode := bdLeftToRight;
  // in left-to-right languages translation must be set after the flip
  UpdateCaption('E');
end;

procedure TFMenu.AHebrewExecute(Sender: TObject);
begin
  // in right-to-left languages translation must be set before the flip
  UpdateCaption('H');
  if (FPaint.BiDiMode = bdLeftToRight) then
    FPaint.FlipChildren(true);
  FPaint.BiDiMode := bdRightToLeft;
  FMenu.BiDiMode := bdRightToLeft;
end;

procedure TFMenu.AStretchExecute(Sender: TObject);
begin
  /// open stretch / skew dialog
  FStretchSkew.ShowModal;
end;

procedure TFMenu.AInvertExecute(Sender: TObject);
begin
  Invert(FPaint.FWA.Im.Picture.Bitmap);
  FPaint.FWA.MyStat.Changed := true;
end;

procedure TFMenu.AAtributesExecute(Sender: TObject);
begin
  /// Attributes Dialog
  FAtr.ShowModal;
end;

procedure TFMenu.AClearImageExecute(Sender: TObject);
begin
  // Clear Image
  if SaveOrExit then
    exit;
  with FPaint.FWA.Im do
    with Canvas do
      with Picture.Bitmap do
      begin
        Brush.Bitmap.free;
        Brush.Style := bsSolid;
        Brush.Color := clwhite;
        Pen.Color := clwhite;
        Rectangle(0, 0, width, Height);
        Brush.Color := FPaint.FrColor1.Pc.Color;
        Pen.Color := FPaint.FrColor1.Bc.Color;
      end;
end;

procedure TFMenu.ADrawOpaqueExecute(Sender: TObject);
begin
  // Draw Opaque (not Opaque->transparentcolor=clwhite insted of $fffeff);
end;

end.
